SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00004 1 05-25-9408:11ALL HELGE HELGESEN TStream for XMS SWAG9405 61 ä▒ π{$A+,B-,D+,E-,F-,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V-,X+,Y+}π{.$DEFINE OPRO}π{π This unit adds an XMS-memory stream to TStream or IdStreamπ depending on the define above.π (c) 1994 Helge Olav Helgesenπ If you have any comments, please leave them in the Pascalπ conference on Rime or U'NI, or on InterNet to me atπ helge.helgesen@midnight.powertech.noπ}π{$IFNDEF MSDOS}π !! This unit must be compiled under real mode !!π{$ENDIF}πUnit Xms;ππinterfaceππusesπ{$IFDEF OPRO}π OpRoot,π{$ELSE}π Objects,π{$ENDIF}π OpDos, OpXms;ππtypeπ PXmsStream = ^TXmsStream; { pointer to TXmsStream }π TXmsStream = object({$IFDEF OPRO}IdStream{$ELSE}TStream{$ENDIF})π XmsSizeInK, { allocated size in kilobytes }π XmsHandle: word; { XMS Handle }π TotalSize, { total size in bytes }π CurOfs, { current offset into the stream }π UsedSize: longint; { size of used stream }ππ constructor Init(MemNeeded: word); { allocate ext. memory and init vars }π destructor Done; virtual; { deallocate ext. memory }ππ procedure Seek(WhereTo: longint); virtual; { seek within stream }π function GetPos: longint; virtual; { get curret offset }π function GetSize: longint; virtual; { get used size of stream }π procedure SetPos(Ofs: longint; Mode: byte); virtual; { seek using POS modeπ }ππ procedure Truncate; virtual; { truncate stream to current size }ππ procedure Write(var Buf; Count: Word); virtual; { writes Buf to the streamπ }π procedure Read(var Buf; Count: Word); virtual; { reads Buf from the streamπ }π end; { TXmsStream }ππ{$IFNDEF OPRO}πvarπ InitStatus: byte; { detailed error code from last Init or Done }π{$ENDIF}ππconstπ RealMemHandle = 0; { handle for Real Memory }π{$IFNDEF OPRO}π PosAbs = 0; {Relative to beginning}π PosCur = 1; {Relative to current position}π PosEnd = 2; {Relative to end}π{$ENDIF}ππ{$IFDEF OPRO}πprocedure SaveStream(const FileName: string; var S: IdStream);π { Saves a stream to disk, old file is erased! }πprocedure LoadStream(const FileName: string; var S: IdStream);π { Loads a stream from disk }π{$ELSE}πprocedure SaveStream(const FileName: string; var S: TStream);π { Saves a stream to disk, old file is erased! }πprocedure LoadStream(const FileName: string; var S: TStream);π { Loads a stream from disk }π{$ENDIF}ππimplementationππconstructor TXmsStream.Init;π { You should already have tested if XMS is installed! }πbeginπ if not inherited Init then Fail;π InitStatus:=AllocateExtMem(MemNeeded, XmsHandle);π if InitStatus>0 then Fail;π XmsSizeInK:=MemNeeded;π TotalSize:=LongInt(MemNeeded)*LongInt(1024);π UsedSize:=0;π CurOfs:=0;πend; { TXmsStream }ππdestructor TXmsStream.Done;πbeginπ FreeExtMem(XmsHandle);π inherited Done;πend; { TXmsStream.Done }ππprocedure TXmsStream.Seek;πbeginπ{$IFDEF OPRO}π if idStatus=0 thenπ{$ELSE}π if Status=stOk thenπ{$ENDIF}π CurOfs:=WhereTo;πend; { TXmsStream }ππfunction TXmsStream.GetPos;πbeginπ{$IFDEF OPRO}π if idStatus=0 thenπ{$ELSE}π if Status=stOk thenπ{$ENDIF}π GetPos:=CurOfs else GetPos:=-1;πend; { TXmsStream.GetPos }ππfunction TXmsStream.GetSize;πbeginπ{$IFDEF OPRO}π if idStatus=0 thenπ{$ELSE}π if Status=stOk thenπ{$ENDIF}π GetSize:=UsedSize else GetSize:=-1;πend; { TXmsStream.GetSize }ππprocedure TXmsStream.Truncate;πbeginπ{$IFDEF OPRO}π if idStatus=0 thenπ{$ELSE}π if Status=stOk thenπ{$ENDIF}π UsedSize:=CurOfs;πend; { TXmsStream.Truncate }ππprocedure TXmsStream.Write;πvarπ NumberisOdd: boolean;π x: word;π Source, Dest: ExtMemPtr;πbeginπ{$IFDEF OPRO}π if idStatus<>0 thenπ{$ELSE}π if Status<>stOk thenπ{$ENDIF}π Exit;π if LongInt(Count)+LongInt(CurOfs)>LongInt(TotalSize) thenπ beginπ{$IFDEF OPRO}π Error(101); { disk write error }π{$ELSE}π Error(stWriteError, 0);π{$ENDIF}π Exit;π end; { if }π NumberIsOdd:=Odd(Count);π if NumberIsOdd then Dec(Count);π Source.RealPtr:=@Buf;π Dest.ProtectedPtr:=CurOfs;π if Count>0 thenπ x:=MoveExtMemBlock(Count, RealMemHandle, Source, { source data }π XmsHandle, Dest) { dest data }π else x:=0;π if x>0 then { new error }π beginπ{$IFDEF OPRO}π Error(101); { disk write error }π{$ELSE}π Error(stWriteError, x);π{$ENDIF}π Exit;π end; { if }π Inc(CurOfs, Count); { adjust current offset }π if CurOfs>UsedSize then UsedSize:=CurOfs;π if not NumberisOdd then Exit;π asm { get last byte to transfer }π les di, Bufπ mov bx, Countπ mov ax, es:[di+bx]π inc Countπ mov x, axπ end; { asm }π Source.RealPtr:=@x;π Inc(Dest.ProtectedPtr, Count-1);π Count:=2;π x:=MoveExtMemBlock(Count, RealMemHandle, Source, { source data }π XmsHandle, Dest); { dest data }π if x>0 then { new error }π beginπ{$IFDEF OPRO}π Error(101); { disk write error }π{$ELSE}π Error(stWriteError, x);π{$ENDIF}π Exit;π end; { if }π Inc(CurOfs);π if CurOfs>UsedSize then UsedSize:=CurOfs;πend; { TXmsStream.Write }ππprocedure TXmsStream.Read;πvarπ NumberisOdd: boolean;π x: word;π Source, Dest: ExtMemPtr;πbeginπ{$IFDEF OPRO}π if idStatus<>0 thenπ{$ELSE}π if Status<>stOk thenπ{$ENDIF}π Exit;π if LongInt(CurOfs)+LongInt(Count)>LongInt(UsedSize) thenπ begin { read error }π{$IFDEF OPRO}π Error(100); { read error }π{$ELSE}π Error(stReadError, 0);π{$ENDIF}π Exit;π end; { if }π NumberisOdd:=Odd(Count);π if NumberisOdd then Inc(Count);π Source.ProtectedPtr:=CurOfs;π Dest.RealPtr:=@Buf;π x:=MoveExtMemBlock(Count, XmsHandle, Source, { source data }π RealMemHandle, Dest); { dest data }π if x>0 thenπ beginπ{$IFDEF OPRO}π Error(100); { read error }π{$ELSE}π Error(stReadError, x);π{$ENDIF}π Exit;π end; { if }π if NumberisOdd then Dec(Count);π Inc(CurOfs, Count);πend; { TXmsStream.Read }ππprocedure TXmsStream.SetPos;πbeginπ case Mode ofπ PosAbs: Seek(Ofs);π PosCur: Seek(LongInt(Ofs)+LongInt(CurOfs));π PosEnd: Seek(LongInt(UsedSize)-LongInt(Ofs));π end; { case }πend; { TXmsStream.SetPos }ππprocedure SaveStream;π{π Saves the stream to disk. No errorchecking is doneπ}πvarπ Buf: pointer;π x, BufSize: word;π f: file;π OldPos, l: longint;πbeginπ Assign(f, FileName);π Rewrite(f, 1);π if S.GetSize=0 thenπ beginπ Close(f);π Exit;π end; { if }π if MaxAvail>65520 then BufSize:=65520 else BufSize:=MaxAvail;π GetMem(Buf, BufSize);π OldPos:=S.GetPos;π l:=S.GetSize;π S.Seek(0);π while l<>0 doπ beginπ if l>BufSize then x:=BufSize else x:=l;π S.Read(Buf^, x);π{$IFDEF OPRO}π if S.PeekStatus<>0 thenπ{$ELSE}π if S.Status<>0 thenπ{$ENDIF}π beginπ Close(f);π Exit;π end; { if }π BlockWrite(f, Buf^, x);π Dec(l, x);π end; { while }π Close(f);π FreeMem(Buf, BufSize);π S.Seek(OldPos);πend; { SaveStream }ππprocedure LoadStream;π{π Loads the stream from disk. No errorchecking is done, you must allocateπ enough memory yourself! Any old contents of the stream is erased.π}πvarπ f: file;π BufSize, x: word;π l: longint;π Buf: pointer;πbeginπ if not ExistFile(FileName) then Exit;π Assign(f, FileName);π Reset(f, 1);π S.Seek(0);π S.Truncate;π l:=FileSize(f);π if l>0 thenπ beginπ if MaxAvail>65520 then BufSize:=65520 else BufSize:=MaxAvail;π GetMem(Buf, BufSize);π while l<>0 doπ beginπ BlockRead(f, Buf^, BufSize, x);π S.Write(Buf^, x);π{$IFDEF OPRO}π if S.PeekStatus<>0 thenπ{$ELSE}π if S.Status<>0 thenπ{$ENDIF}π beginπ Close(f);π Exit;π end; { if }π Dec(l, x);π end; { while }π FreeMem(Buf, BufSize);π end; { if }π Close(f);π S.Seek(0);πend; { LoadStream }ππend.π 2 05-25-9408:23ALL ERIK DE NEVE Stack usage report sourceSWAG9405 25 ä▒ {πThe program StackUse below measures your EXACT stack usageπ(REAL mode only). Make sure the constant Ssize is equal to theπactual physical stack size as defined with the $M directive orπin the Turbo Pascal IDE settings (the Options/MemorySizes menu).ππFor your own programs, you just need to call Initstack at the veryπstart, then call StackReport whenever you want - or calculate forπyourself, (Ssize-(VirginStack-StackLimit)) equals the number ofπstack bytes actually used.ππSptr gives you the current stack pointer, and StackLimit isπa TP system variable (WORD) that contains the current bottom ofπof the stack. StackLimit is usually zero, but some 'sneaky'πprograms raise it so they can hide something there - for example,πc1;0compiling your program using the replacement run-time librariesπby Norbert Juffa can raise the StackLimit to 512.πThe stack is filled from top to bottom, so a stack overflowπmeans Sptr <= StackLimit.πUseStack is just an example of a procedure that makes heavyπuse of the stack.ππThis code can be freely included in any FAQ,πSNIPPETS, SWAG or what-have-you.ππ Erik de Neveπ Internet: 100121.1070@compuserve.comππ Last update: March 8, 1994ππ{ -*- CUT HERE -*- }ππProgram StackUse;ππ{$M 16384,0,0 }ππCONSTπ Ssize = 16384; {should match stack size as set by the $M directive }ππProcedure Initstack; { fills unused stack with marker value }π Assembler;π ASMπ PUSH SS { SS = the stack segment }π POP ESπ MOV DI,StackLimitπ MOV CX,SP { SP = stack pointer register }π SUB CX,DIπ MOV AL,77 { arbitrary marker value }π CLDπ REP STOSBπ END;ππFunction VirginStack:word; { finds highest unused byte on stack }π Assembler;π ASMπ PUSH SSπ POP ESπ MOV DI,StackLimit { is usually 0 }π MOV CX,SPπ SUB CX,DIπ MOV AL,77 { marker value, must be the same as in InitStack }π CLDπ REPE SCASB { scan empty stack }π DEC DI { adjust for last non-matching byte in the scan }π MOV AX,DIπ END;πππProcedure StackReport; { Reports all sizes in bytes and percentages }πbeginπ WriteLn('Stack Bottom : ',StackLimit:6);π WriteLn('Current SP : ',Sptr:6);π WriteLn('Total Stack : ',Ssize:6,π ' bytes = 100.00 %');π WriteLn(' Now used : ',Ssize-(Sptr-StackLimit):6,π ' bytes = ',(Ssize-(Sptr-StackLimit))/Ssize *100:6:2,' %');π WriteLn(' Ever used : ',Ssize-(VirginStack-StackLimit):6,π ' bytes = ',(Ssize-(VirginStack-StackLimit))/Ssize *100:6:2,' %');π WriteLn('Never used : ',(VirginStack-StackLimit):6,π ' bytes = ',(VirginStack-StackLimit)/Ssize *100:6:2,' %');πend;πππProcedure UseStack(CNT:WORD); Assembler; { example stack usage }π ASMπ MOV AX,0 {dummy value}π MOV CX,CNTπ@pushit: {perform CNT PUSHes}π PUSH AXπ LOOP @pushitπ MOV CX,CNTπ@poppit: {perform CNT POPs}π POP AXπ LOOP @poppitπ END;πππBEGINπ InitStack; { prepare stack }π UseStack(1000); { perform a number of PUSHes and POPs }π StackReport; { report stack usage }πEND.π 3 05-26-9406:14ALL JENS LARSSON Moving Memory 2 Memory SWAG9405 4 ä▒ {This copies NumBytes from SourceOfs to DestOfs:}ππProcedure MoveGfxMem(NumBytes, SourceOfs, DestOfs : Word); Assembler;π Asmπ push dsπ mov ax,0a000hπ mov ds,axπ mov es,axπ mov si,SourceOfsπ mov di,DestOfsπ mov cx,NumBytesπ cldπ rep movsbπ pop dsπ End;ππ 4 05-26-9411:04ALL RICHARD SADOWSKY Compare areas of Memory SWAG9405 16 ä▒ {$R-,S-,V-}π{π**π** CompMem - A routine to compare to areas of memory for equalityπ** by Richard S. Sadowsky [74017,1670]π** version 1.0 5/11/88π** released to the public domainπ** requires file MEMCOMP.OBJ to recompileπ**ππ}πunit MemComp;ππinterfaceππfunction CompMem(var Block1,Block2; Size : Word) : Word;π{ returns 0 if Block1 and Block2 are equal for Size bytes, otherwise }π{ returns position of first non matching byte }ππimplementationππfunction CompMem(var Block1,Block2; Size : Word) : Word; External;π{$L memcomp.Obj}ππend.ππ{ --------------------- XX3402 CODE --------------------- }π{ cut this out and save as MEMCOMP.XX execute :π{ XX3402 D MEMCOMP.XX to create MEMCOMP.OBJ }ππππ*XX3402-000108-110588--72--85-20839-----MEMCOMP.OBJ--1-OF--1πU+o+0qpZPKBjPL+iEJBBOtM5+++2Eox2FIGM-k+c7++0+E2FY+s+++25EoxBI2p3HE+++2m6π-+++cU5Fc0U++E++WxmAqXD+BchD-CAHBgJr0XP2TkPwwuNo-XO9FkEfkMvOmUc+9sc0++-oπ***** END OF BLOCK 1 *****ππ{ ------------- TEST PROGRAM --------------------- }ππ{$R-,S-}πprogram CompTest;πuses MemComp;ππtypeπ Tipe = array[1..128] of byte;ππvarπ Var1,Var2 : Tipe;π I,CompRes : Word;ππbeginπ FillChar(var2,SizeOf(Tipe),0); { init Var2 to all zeros }π for I := 1 to 128 do { set var1 = 1 2 3 4 5 ... 128 }π Var1[I] := I;π CompRes := CompMem(Var1,Var2,128); { compare, should return first }π { byte as non match }π WriteLn('While not equal, CompMem = ',CompRes); { show results }π Var2 := Var1; { make them equal }π CompRes := CompMem(Var1,Var2,128); { test again, should return 0 }π WriteLn('While equal, CompMem = ',CompRes);π Var2[128] := 0; { make all equal except last byte }π CompRes := CompMem(Var1,Var2,128); { test again, should return 128 }π WriteLn('While not equal, CompMem = ',CompRes);πend.π
